home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue68 / sync / testFileSync1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-02-28  |  6.2 KB  |  258 lines
  1. unit testFileSync1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, 
  8.   GpFileSync;
  9.  
  10. type
  11.   TfrmMain = class(TForm)
  12.     btnAcquiredQ: TButton;
  13.     btnDoneReading: TButton;
  14.     btnDoneWriting: TButton;
  15.     btnEnterCS: TButton;
  16.     btnEnterM: TButton;
  17.     btnJoinG: TButton;
  18.     btnLeaveCS: TButton;
  19.     btnLeaveG: TButton;
  20.     btnLeaveM: TButton;
  21.     btnReadSWMR: TButton;
  22.     btnReceiveMsg: TButton;
  23.     btnResetE: TButton;
  24.     btnSendMsg: TButton;
  25.     btnSignalE: TButton;
  26.     btnWaitForE: TButton;
  27.     btnWriteSWMR: TButton;
  28.     cbDeleteCS: TCheckBox;
  29.     cbDeleteG: TCheckBox;
  30.     cbDeleteM: TCheckBox;
  31.     cbDeleteSWMR: TCheckBox;
  32.     cbResetE: TCheckBox;
  33.     lbLog: TListBox;
  34.     procedure btnAcquiredQClick(Sender: TObject);
  35.     procedure btnEnterCSClick(Sender: TObject);
  36.     procedure btnEnterMClick(Sender: TObject);
  37.     procedure btnJoinGClick(Sender: TObject);
  38.     procedure btnLeaveCSClick(Sender: TObject);
  39.     procedure btnLeaveGClick(Sender: TObject);
  40.     procedure btnLeaveMClick(Sender: TObject);
  41.     procedure btnReceiveMsgClick(Sender: TObject);
  42.     procedure btnResetEClick(Sender: TObject);
  43.     procedure btnSendMsgClick(Sender: TObject);
  44.     procedure btnSignalEClick(Sender: TObject);
  45.     procedure btnWaitForEClick(Sender: TObject);
  46.     procedure cbDeleteCSClick(Sender: TObject);
  47.     procedure cbDeleteGClick(Sender: TObject);
  48.     procedure cbDeleteMClick(Sender: TObject);
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure FormDestroy(Sender: TObject);
  51.     procedure btnWriteSWMRClick(Sender: TObject);
  52.     procedure btnReadSWMRClick(Sender: TObject);
  53.     procedure btnDoneWritingClick(Sender: TObject);
  54.     procedure btnDoneReadingClick(Sender: TObject);
  55.   private
  56.     cs  : TGpFileCriticalSection;
  57.     e   : TGpFileEvent;
  58.     g   : TGpFileGroup;
  59.     m   : TGpFileMutex;
  60.     msg : TGpFileMessage;
  61.     swmr: TGpFileSWMR;
  62.   public
  63.   end;
  64.  
  65. var
  66.   frmMain: TfrmMain;
  67.  
  68. implementation
  69.  
  70. {$R *.DFM}
  71.  
  72. const
  73.   CSName   = 'TestFileSync.CS';
  74.   EName    = 'TestFileSync.E';
  75.   GName    = 'TestFileSync.G';
  76.   MName    = 'TestFileSync.M';
  77.   MsgName  = 'TestFileSync.Msg';
  78.   SName    = 'TestFileSync.S';
  79.   SWMRName = 'TestFileSync.SWMR';
  80.  
  81. procedure TfrmMain.FormCreate(Sender: TObject);
  82. begin
  83.   cs := TGpFileCriticalSection.Create(CSName,cbDeleteCS.Checked);
  84.   m := TGpFileMutex.Create(MName,cbDeleteM.Checked);
  85.   e := TGpFileEvent.Create(EName);
  86.   g := TGpFileGroup.Create(GName,cbDeleteG.Checked);
  87.   msg := TGpFileMessage.Create(MsgName);
  88.   swmr := TGpFileSWMR.Create(SWMRName,cbDeleteSWMR.Checked);
  89. end;
  90.  
  91. procedure TfrmMain.FormDestroy(Sender: TObject);
  92. begin
  93.   FreeAndNil(cs);
  94.   FreeAndNil(m);
  95.   FreeAndNil(e);
  96.   FreeAndNil(g);
  97.   FreeAndNil(msg);
  98.   FreeAndNil(swmr);
  99. end;
  100.  
  101. procedure TfrmMain.btnEnterCSClick(Sender: TObject);
  102. begin
  103.   cs.Enter;
  104.   cbDeleteCS.Enabled := false;
  105.   lbLog.Items.Add('Entered');
  106. end;
  107.  
  108. procedure TfrmMain.btnLeaveCSClick(Sender: TObject);
  109. begin
  110.   cs.Leave;
  111.   cbDeleteCS.Enabled := true;
  112.   lbLog.Items.Add('Left');
  113. end;
  114.  
  115. procedure TfrmMain.cbDeleteCSClick(Sender: TObject);
  116. begin
  117.   FreeAndNil(cs);
  118.   cs := TGpFileCriticalSection.Create(CSName,cbDeleteCS.Checked);
  119. end;
  120.  
  121. procedure TfrmMain.btnEnterMClick(Sender: TObject);
  122. begin
  123.   if not M.Acquire(1000) then
  124.     lbLog.Items.Add('Timeout')
  125.   else begin
  126.     lbLog.Items.Add('Acquired');
  127.     cbDeleteM.Enabled := false;
  128.   end;
  129. end;
  130.  
  131. procedure TfrmMain.btnLeaveMClick(Sender: TObject);
  132. begin
  133.   M.Release;
  134.   cbDeleteM.Enabled := true;
  135.   lbLog.Items.Add('Released');
  136. end;
  137.  
  138. procedure TfrmMain.cbDeleteMClick(Sender: TObject);
  139. begin
  140.   FreeAndNil(m);
  141.   m := TGpFileMutex.Create(MName,cbDeleteM.Checked);
  142. end;
  143.  
  144. procedure TfrmMain.btnSignalEClick(Sender: TObject);
  145. begin
  146.   if e.Signal then
  147.     lbLog.Items.Add('Signalled')
  148.   else
  149.     lbLog.Items.Add('Already signalled');
  150. end;
  151.  
  152. procedure TfrmMain.btnWaitForEClick(Sender: TObject);
  153. begin
  154.   if e.WaitFor(1000,cbResetE.Checked) then
  155.     lbLog.Items.Add('Awaited')
  156.   else
  157.     lbLog.Items.Add('Timeout')
  158. end;
  159.  
  160. procedure TfrmMain.btnResetEClick(Sender: TObject);
  161. begin
  162.   if e.Reset then
  163.     lbLog.Items.Add('Reset')
  164.   else
  165.     lbLog.Items.Add('Already reset');
  166. end;
  167.  
  168. procedure TfrmMain.btnAcquiredQClick(Sender: TObject);
  169. begin
  170.   if m.Acquired then
  171.     lbLog.Items.Add('Yes')
  172.   else
  173.     lbLog.Items.Add('No');
  174. end;
  175.  
  176. procedure TfrmMain.cbDeleteGClick(Sender: TObject);
  177. begin
  178.   FreeAndNil(g);
  179.   g := TGpFileGroup.Create(GName,cbDeleteG.Checked);
  180. end;
  181.  
  182. procedure TfrmMain.btnJoinGClick(Sender: TObject);
  183. var
  184.   isFirst: boolean;
  185. begin
  186.   if g.Join(INFINITE,isFirst) then
  187.     lbLog.Items.Add('Joined, isFirst: '+IntToStr(Ord(isFirst)))
  188.   else
  189.     lbLog.Items.Add('Already joined');
  190. end;
  191.  
  192. procedure TfrmMain.btnLeaveGClick(Sender: TObject);
  193. var
  194.   wasLast: boolean;
  195. begin
  196.   if g.Leave(INFINITE,wasLast) then
  197.     lbLog.Items.Add('Left, wasLast: '+IntToStr(Ord(wasLast)))
  198.   else
  199.     lbLog.Items.Add('Already left');
  200. end;
  201.  
  202. procedure TfrmMain.btnSendMsgClick(Sender: TObject);
  203. var
  204.   s: string;
  205. begin
  206.   s := 'Message';
  207.   lbLog.Items.Add('Send: '+IntToStr(Ord(msg.Send(3000,@s[1],Length(s)))));
  208. end;
  209.  
  210. procedure TfrmMain.btnReceiveMsgClick(Sender: TObject);
  211. var
  212.   msgData: pointer;
  213.   msgSize: integer;
  214.   s      : string;
  215. begin
  216.   if msg.Receive(3000,msgData,msgSize) then begin
  217.     SetLength(s,msgSize);
  218.     Move(msgData^,s[1],msgSize);
  219.     FreeMem(msgData);
  220.     lbLog.Items.Add('Received: '+s);
  221.   end
  222.   else
  223.     lbLog.Items.Add('Timeout');
  224. end;
  225.  
  226. procedure TfrmMain.btnWriteSWMRClick(Sender: TObject);
  227. begin
  228.   if not swmr.WaitToWrite(5000) then
  229.     lbLog.Items.Add('Cannot write')
  230.   else
  231.     lbLog.Items.Add('Writing');
  232. end;
  233.  
  234. procedure TfrmMain.btnReadSWMRClick(Sender: TObject);
  235. begin
  236.   if not swmr.WaitToRead(5000) then
  237.     lbLog.Items.Add('Cannot read')
  238.   else
  239.     lbLog.Items.Add('Reading');
  240. end;
  241.  
  242. procedure TfrmMain.btnDoneWritingClick(Sender: TObject);
  243. begin
  244.   swmr.DoneWriting;
  245.   lbLog.Items.Add('Not writing');
  246. end;
  247.  
  248. procedure TfrmMain.btnDoneReadingClick(Sender: TObject);
  249. begin
  250.   if not swmr.DoneReading(5000) then
  251.     lbLog.Items.Add('Cannot stop reading')
  252.   else
  253.     lbLog.Items.Add('Not reading');
  254. end;
  255.  
  256. end.
  257.  
  258.